home *** CD-ROM | disk | FTP | other *** search
/ MacHack 1996 / MacHack 1996.toast / Hacks / Hacks ’90 / DataStack Filer / DataStacks.Mod < prev    next >
Encoding:
Modula Implementation  |  1995-09-10  |  20.1 KB  |  804 lines  |  [TEXT/MPS ]
  1. IMPLEMENTATION MODULE DataStacks;
  2. (*    Copyright:    © 1990 by Keith Nemitz, all rights reserved. *)
  3. FROM SYSTEM IMPORT ADR,ADDRESS;
  4.  
  5. FROM MacTypes IMPORT Ptr,OSErr,Str31,StringPtr,debugstr;
  6. FROM MemoryManager IMPORT NewPtr,DisposPtr,NewHandle,DisposHandle,MemError,
  7.         MoveHHi,HLock,HUnlock,BlockMove,GetHandleSize,SetHandleSize,noErr;
  8. FROM FileManager IMPORT FSRead,FSWrite,Allocate;
  9.  
  10. FROM LocLib IMPORT CopyStr;
  11.  
  12.  
  13. TYPE
  14.     GrowStack = POINTER TO GrowStackPtr;
  15.     GrowStackPtr = POINTER TO GrowStackRec;
  16.     GrowStackRec = RECORD
  17.                             dataPtr :Ptr;
  18.                             filledCards :CARDINAL; (* last index in grow space. *)
  19.                             growStk :GrowStack;
  20.                             END;
  21.  
  22.     DataKeysHnd = POINTER TO DataKeysPtr;
  23.     DataKeysPtr = POINTER TO ARRAY [0..0] OF CARDINAL;
  24.     (* cardinal points to block in dataStack.
  25.             if point beyond main stack
  26.             then count grow stacks to resolve lookup. *)
  27.     
  28.     DataStack = POINTER TO DataStackPtr;
  29.     DataStackPtr = POINTER TO DataStackRec;
  30.     DataStackRec = RECORD
  31.                             cardSize :CARDINAL; (* contains size requested + SIZE(header) *)
  32.                             initialCards :CARDINAL;
  33.                             growCards :CARDINAL;
  34.                             filledCards :CARDINAL; (* last index in initial space. *)
  35.                             totalFilled :CARDINAL; (* last index of all cards. *)
  36.                             idCount :LONGCARD;
  37.  
  38.                             dataPtr :Ptr;
  39.                             idKeys :DataKeysHnd;
  40.                             nameKeys :DataKeysHnd;
  41.                             growStk :GrowStack;
  42.                             END;
  43.  
  44.  
  45.     HeadPtr = POINTER TO CardHeader;
  46.     CardHeader = RECORD
  47.                         cName :Str31; (* code requires cName is first in record. *)
  48.                         id :LONGCARD;
  49.                         
  50.                         (* stuff *)
  51.                         END;
  52.     CONST
  53.         headerSize = SIZE(CardHeader);
  54.  
  55.  
  56. PROCEDURE AllocContig(refNum:INTEGER; VAR count:LONGINT):OSErr; EXTERNAL PASCAL;
  57. PROCEDURE IUCompString(aStrPtr, bStrPtr: ADDRESS): INTEGER; EXTERNAL PASCAL;
  58.  
  59.  
  60. PROCEDURE NewDataStack(cSize,initial,grow:CARDINAL):DataStack;
  61. VAR
  62.     dPtr :Ptr;
  63.     dataInfo :DataStack;
  64.     idArr,nameArr :DataKeysHnd;
  65. BEGIN
  66.     dataStackErr := noErr;
  67.     IF (MAX(CARDINAL)-cSize) < headerSize THEN
  68.         dataStackErr := cardSizeTooBig;
  69.         RETURN NIL;
  70.         END;
  71.     INC(cSize,headerSize);
  72.  
  73.     dPtr := NewPtr(VAL(LONGINT,cSize * initial));
  74.     IF dPtr = NIL THEN
  75.         dataStackErr := MemError();
  76.         RETURN NIL;
  77.         END;
  78.     
  79.     idArr := NewHandle(VAL(LONGINT,initial)*SIZE(CARDINAL) +SIZE(CARDINAL));
  80.     nameArr := NewHandle(VAL(LONGINT,initial)*SIZE(CARDINAL) +SIZE(CARDINAL));
  81.     IF nameArr = NIL THEN
  82.         dataStackErr := MemError();
  83.         DisposHandle(idArr);
  84.         DisposPtr(dPtr);
  85.         RETURN NIL;
  86.         END;
  87.     
  88.  
  89.     dataInfo := NewHandle(SIZE(DataStackRec));
  90.     IF dataInfo = NIL THEN 
  91.         dataStackErr := MemError();
  92.         DisposHandle(idArr);
  93.         DisposHandle(nameArr);
  94.         DisposPtr(dPtr);
  95.         RETURN NIL;
  96.         END;
  97.     
  98.     WITH dataInfo^^ DO
  99.         initialCards := initial;
  100.         growCards := grow;
  101.         cardSize := cSize;
  102.         filledCards := 0;
  103.         totalFilled := 0;
  104.         idCount := 0;
  105.         
  106.         dataPtr := dPtr;
  107.         idKeys := idArr;
  108.         nameKeys := nameArr;
  109.         growStk := NIL;
  110.         END; (*with*)
  111.     RETURN dataInfo;
  112.     END NewDataStack;
  113.  
  114.  
  115. PROCEDURE LoadKeyArrays(idArr,nameArr:DataKeysHnd; n:CARDINAL; fid:INTEGER):BOOLEAN;
  116. VAR
  117.     count,count2 :LONGINT;
  118. BEGIN
  119.     dataStackErr := noErr;
  120.     count := VAL(LONGINT,n)*SIZE(CARDINAL) + SIZE(CARDINAL);
  121.     count2 := count;
  122.     
  123.     dataStackErr := FSRead(fid,count,idArr^);
  124.     IF dataStackErr # 0 THEN RETURN FALSE; END;
  125.     
  126.     dataStackErr := FSRead(fid,count2,nameArr^);
  127.     IF dataStackErr # 0 THEN RETURN FALSE; END;
  128.     
  129.     RETURN TRUE;
  130.     END LoadKeyArrays;
  131.  
  132. PROCEDURE LoadDataStack(fRefNum:INTEGER):DataStack;
  133. VAR
  134.     dataStkR :DataStackRec;
  135.     dataStk :DataStack;
  136.     count :LONGINT;
  137. BEGIN
  138.     dataStackErr := noErr;
  139.     (* load header *)
  140.     count := SIZE(DataStackRec);
  141.     dataStackErr := FSRead(fRefNum,count,ADR(dataStkR));
  142.     IF dataStackErr # 0 THEN RETURN NIL; END;
  143.     
  144.     (* new data stack *)
  145.     WITH dataStkR DO
  146.         dataStk := NewDataStack(cardSize,initialCards,growCards);
  147.         END;
  148.     IF dataStk = NIL THEN RETURN NIL; END;
  149.         
  150.     WITH dataStk^^ DO
  151.         filledCards := dataStkR.filledCards;
  152.         totalFilled := dataStkR.filledCards;
  153.         idCount := dataStkR.idCount;
  154.  
  155.         IF NOT LoadKeyArrays(idKeys,nameKeys,totalFilled,fRefNum) THEN
  156.             DisposeDataStack(dataStk);
  157.             RETURN NIL;
  158.             END;
  159.  
  160.     (* load body *)
  161.         count := VAL(LONGINT,cardSize * filledCards);
  162.         dataStackErr := FSRead(fRefNum,count,dataPtr);
  163.         END;(*with*)
  164.     IF dataStackErr # 0 THEN 
  165.         DisposeDataStack(dataStk);
  166.         RETURN NIL;
  167.         END;(*with*)
  168.     
  169.     RETURN dataStk;
  170.     END LoadDataStack;
  171.  
  172.  
  173. PROCEDURE WriteGrowStacks(gStk :GrowStack; cardSize:CARDINAL; fRefNum:INTEGER);
  174. VAR count :LONGINT;
  175. BEGIN
  176.     IF gStk = NIL THEN RETURN; END;
  177.     
  178.     WITH gStk^^ DO
  179.         count := VAL(LONGINT,filledCards * cardSize);
  180.         dataStackErr := FSWrite(fRefNum,count,dataPtr);
  181.         IF dataStackErr # 0 THEN RETURN; END;
  182.         END;
  183.     
  184.     WriteGrowStacks(gStk^^.growStk,cardSize,fRefNum);
  185.     END WriteGrowStacks;
  186.  
  187. PROCEDURE DumpDataStack(stack:DataStack; fRefNum:INTEGER):BOOLEAN;
  188. VAR
  189.     err :OSErr;
  190.     dataStkR :DataStackRec;
  191.     count,count2 :LONGINT;
  192. BEGIN
  193.     dataStackErr := noErr;
  194.     (* verify disk space *)
  195.     WITH stack^^ DO
  196.         IF totalFilled < filledCards THEN RETURN FALSE; END;
  197.  
  198.         count := SIZE(DataStackRec) + ( VAL(LONGINT,cardSize) * VAL(LONGINT,totalFilled) );
  199.         INC(count,VAL(LONGINT,totalFilled)*4); (* space for both keys arrays *)
  200.         count2 := count;
  201.         END;
  202.     err := AllocContig(fRefNum,count);
  203.     IF err # 0 THEN
  204.         dataStackErr := Allocate(fRefNum,count2);
  205.         IF dataStackErr # 0 THEN RETURN FALSE; END;
  206.         END;
  207.     dataStkR := stack^^; (* save copy of dataStackRecord. *)
  208.     WITH dataStkR DO
  209.         DEC(cardSize,headerSize); (* rebuild DataStack when restored with orig. size. *)
  210.         filledCards := totalFilled; (* when restored, filled = total. *)
  211.         IF initialCards < totalFilled THEN
  212.             initialCards := totalFilled;
  213.             END;
  214.         END;(*with*)
  215.  
  216.     (* write header *)
  217.     count := SIZE(DataStackRec);
  218.     dataStackErr := FSWrite(fRefNum,count,ADR(dataStkR));
  219.     IF dataStackErr # 0 THEN RETURN FALSE; END;
  220.     
  221.     (* write keys arrays *)
  222.     WITH stack^^ DO
  223.         count := VAL(LONGINT,totalFilled)*SIZE(CARDINAL) + SIZE(CARDINAL);
  224.         count2 := count;
  225.         dataStackErr := FSWrite(fRefNum,count,idKeys^);
  226.         IF dataStackErr # 0 THEN RETURN FALSE; END;
  227.         
  228.         dataStackErr := FSWrite(fRefNum,count2,nameKeys^);
  229.         IF dataStackErr # 0 THEN RETURN FALSE; END;
  230.         END; (*with*)
  231.     
  232.     (* write stack *)
  233.     WITH stack^^ DO
  234.         count := VAL(LONGINT,filledCards * cardSize);
  235.         dataStackErr := FSWrite(fRefNum,count,dataPtr);
  236.         IF dataStackErr # 0 THEN RETURN FALSE; END;
  237.         END;
  238.     
  239.     (* write grow stacks *)
  240.     WriteGrowStacks(stack^^.growStk,stack^^.cardSize,fRefNum);
  241.     IF dataStackErr # noErr THEN RETURN FALSE; END;
  242.  
  243.     RETURN TRUE;
  244.     END DumpDataStack;
  245.  
  246.  
  247. PROCEDURE DisposeDataStack(stack:DataStack);
  248. VAR gs,tgs :GrowStack;
  249. BEGIN
  250.     DisposPtr(stack^^.dataPtr);
  251.     DisposHandle(stack^^.idKeys);
  252.     DisposHandle(stack^^.nameKeys);
  253.     
  254.     gs := stack^^.growStk;
  255.     WHILE gs # NIL DO
  256.         tgs := gs;
  257.         DisposPtr(gs^^.dataPtr);
  258.         gs := gs^^.growStk;
  259.         DisposHandle(tgs);
  260.         END;
  261.     DisposHandle(stack);
  262.     END DisposeDataStack;
  263.  
  264.  
  265. (* *****************************   card routines   ******************************** *)
  266.  
  267. PROCEDURE FindGrowHeaderAddr(gStk:GrowStack; cardNum0,cSize:CARDINAL):HeadPtr;
  268. BEGIN
  269.     WITH gStk^^ DO
  270.         IF cardNum0 >= filledCards THEN
  271.             RETURN FindGrowHeaderAddr(growStk,cardNum0-filledCards,cSize);
  272.         ELSE
  273.             RETURN VAL(ADDRESS, VAL(LONGCARD,cSize) * VAL(LONGCARD,cardNum0)) + 
  274.                         VAL(ADDRESS, dataPtr);
  275.             END;
  276.         END;
  277.     END FindGrowHeaderAddr;
  278.  
  279. PROCEDURE GetHeaderAddr(stack:DataStack; cardNum:CARDINAL):HeadPtr;
  280. BEGIN
  281.     IF stack = NIL THEN RETURN NIL END;
  282.     IF (cardNum < 1) OR (cardNum > stack^^.totalFilled) THEN RETURN NIL; END;
  283.     DEC(cardNum); (* gives 0 based indexing to cardHeader *)
  284.     WITH stack^^ DO
  285.         IF cardNum >= filledCards THEN
  286.             RETURN FindGrowHeaderAddr(growStk,cardNum-filledCards,cardSize);
  287.         ELSE
  288.             RETURN VAL( ADDRESS,VAL(LONGCARD,cardNum) * VAL(LONGCARD,cardSize) ) 
  289.                              + VAL(ADDRESS, dataPtr);
  290.             END;
  291.         END;
  292.     END GetHeaderAddr;
  293.  
  294.  
  295.     (* **************************   search routines   ***************************** *)
  296.  
  297.     VAR
  298.         theKeyIndex :CARDINAL;    (* index of last compare before return/failure *)
  299.         
  300.         theSearchID :LONGCARD;
  301.         theSearchName :StringPtr;
  302.         theStack :DataStack; (* stack to be searched *)
  303.     
  304.     PROCEDURE SearchStackByName(min,max :CARDINAL):CARDINAL;
  305.     VAR
  306.         strPtr :StringPtr;
  307.         n :INTEGER;
  308.     BEGIN
  309.         IF max < min THEN RETURN 0; END;
  310.         theKeyIndex := (min+max) DIV 2;
  311.         
  312.         strPtr := VAL(StringPtr,GetHeaderAddr(theStack,theStack^^.nameKeys^^[theKeyIndex]));
  313.         n := IUCompString(theSearchName,strPtr);
  314.         
  315.         IF n = 0 THEN                                    (* theSearchX matches (indx)^. *)
  316.             RETURN theKeyIndex; 
  317.         ELSIF n < 0 THEN                                (* theSearchX preceeds (indx)^. *)
  318.             RETURN SearchStackByName(min,theKeyIndex-1);
  319.         ELSE                                                (* theSearchX follows (indx)^. *)
  320.             RETURN SearchStackByName(theKeyIndex+1,max);
  321.             END;
  322.         END SearchStackByName;
  323.     
  324.     PROCEDURE SearchStackByID(min,max :CARDINAL):CARDINAL;
  325.     VAR 
  326.         header :HeadPtr;
  327.         strPtr :StringPtr;
  328.         n :INTEGER;
  329.     BEGIN
  330.         IF max < min THEN RETURN 0; END;
  331.         theKeyIndex := (min+max) DIV 2;
  332.         
  333.         header := GetHeaderAddr(theStack,theStack^^.idKeys^^[theKeyIndex]);
  334.         
  335.         IF theSearchID = header^.id THEN
  336.             RETURN theKeyIndex;
  337.         ELSIF theSearchID < header^.id THEN
  338.             RETURN SearchStackByID(min,theKeyIndex-1);
  339.         ELSE
  340.             RETURN SearchStackByID(theKeyIndex+1,max);
  341.             END;
  342.         END SearchStackByID;
  343.     
  344.  
  345.  
  346. PROCEDURE NewGrowStack(stack:DataStack):GrowStack;
  347. VAR
  348.     gStk :GrowStack;
  349.     dPtr :Ptr;
  350.     gCards :CARDINAL;
  351.     iKeys,nKeys :DataKeysHnd;
  352.     keyArrSize,gCardKeyGrow :LONGINT;
  353. BEGIN
  354.     WITH stack^^ DO
  355.         iKeys := idKeys;
  356.         nKeys := nameKeys;
  357.         gCardKeyGrow := VAL(LONGINT,growCards)*SIZE(CARDINAL);
  358.         
  359.         dPtr := NewPtr(VAL(LONGINT,cardSize) * VAL(LONGINT,growCards));
  360.         IF dPtr = NIL THEN 
  361.             dataStackErr := MemError();
  362.             RETURN NIL;
  363.             END;
  364.         END;
  365.  
  366.     keyArrSize := GetHandleSize(iKeys);
  367.     SetHandleSize(iKeys,keyArrSize + gCardKeyGrow);
  368.     IF MemError() # 0 THEN
  369.         dataStackErr := MemError();
  370.         DisposPtr(dPtr);
  371.         RETURN NIL;
  372.         END;
  373.     SetHandleSize(nKeys,keyArrSize + gCardKeyGrow);
  374.     IF MemError() # 0 THEN
  375.         dataStackErr := MemError();
  376.         SetHandleSize(iKeys,keyArrSize);
  377.         DisposPtr(dPtr);
  378.         RETURN NIL;
  379.         END;
  380.  
  381.     gStk := NewHandle(SIZE(GrowStackRec));
  382.     IF gStk = NIL THEN
  383.         dataStackErr := MemError();
  384.         SetHandleSize(iKeys,keyArrSize);
  385.         SetHandleSize(nKeys,keyArrSize);
  386.         DisposPtr(dPtr);
  387.         RETURN NIL;
  388.         END;
  389.     
  390.     WITH gStk^^ DO
  391.         filledCards := 0;
  392.         dataPtr := dPtr;
  393.         growStk := NIL;
  394.         END;
  395.     RETURN gStk;
  396.     END NewGrowStack;
  397.  
  398. PROCEDURE FindNextGrowCard(stack:DataStack; gStk:GrowStack):HeadPtr;
  399. VAR
  400.     header :HeadPtr;
  401.     cSize, gCards :CARDINAL;
  402. BEGIN
  403.     WITH stack^^ DO
  404.         cSize := cardSize;
  405.         gCards := growCards;
  406.         END;
  407.  
  408.     MoveHHi(gStk);
  409.     HLock(gStk);
  410.     WITH gStk^^ DO
  411.         IF filledCards < gCards THEN
  412.             header := VAL(ADDRESS, VAL(LONGCARD,filledCards) * VAL(LONGCARD,cSize)) + 
  413.                         VAL(ADDRESS, dataPtr);
  414.             INC(filledCards);
  415.         ELSE
  416.             IF growStk = NIL THEN
  417.                 growStk := NewGrowStack(stack);
  418.                 IF growStk = NIL THEN RETURN NIL; END;
  419.                 END;
  420.             header := FindNextGrowCard(stack,growStk);
  421.             END;
  422.         END;
  423.     HUnlock(gStk);
  424.     RETURN header
  425.     END FindNextGrowCard;
  426.  
  427. PROCEDURE AddGrowCard(stack:DataStack):HeadPtr;
  428. VAR gStk :GrowStack;
  429. BEGIN
  430.     IF stack^^.growStk = NIL THEN
  431.         IF stack^^.growCards = 0 THEN RETURN NIL; END;
  432.         gStk := NewGrowStack(stack);
  433.         IF gStk = NIL THEN RETURN NIL; END;
  434.         stack^^.growStk := gStk;
  435.     ELSE
  436.         gStk := stack^^.growStk;
  437.         END;
  438.     RETURN FindNextGrowCard(stack,gStk);
  439.     END AddGrowCard;
  440.  
  441. PROCEDURE FillHeader(stack:DataStack; header:HeadPtr);
  442. VAR
  443.     n,totFil :CARDINAL;
  444.     start :ADDRESS;
  445.     strPtr :StringPtr;
  446.     nKeys :DataKeysHnd;
  447. BEGIN
  448.     WITH stack^^ DO
  449.         INC(idCount);
  450.         header^.id := idCount;
  451.         idKeys^^[totalFilled] := totalFilled; (* new card always has largest ID. *)
  452.         totFil := totalFilled;
  453.         nKeys := nameKeys;
  454.         END;(*with*)
  455.  
  456.     theStack := stack;
  457.     theSearchName := VAL(StringPtr,header);
  458.     theKeyIndex := 1; (* default for empty stack *)
  459.     
  460.     n := SearchStackByName(1,totFil-1);
  461.     IF (n = 0) AND (totFil > 1) THEN
  462.         (* Search failed, and the last index searched was theKeyIndex. *)
  463.         strPtr := VAL(StringPtr,GetHeaderAddr(stack,nKeys^^[theKeyIndex]));
  464.         IF IUCompString(theSearchName,strPtr) > 0 THEN INC(theKeyIndex) END;
  465.     ELSIF (n # 0) THEN
  466.         (* search found a card with same name, so we insert the new nameKey there. *)
  467.         theKeyIndex := n;
  468.         END;
  469.     
  470.     start := ADR(nKeys^^[theKeyIndex]);
  471.     BlockMove(start,start+SIZE(CARDINAL),(totFil-theKeyIndex)*SIZE(CARDINAL));
  472.     nKeys^^[theKeyIndex] := totFil;
  473.     END FillHeader;
  474.  
  475. PROCEDURE AddCard(stack:DataStack; data:ADDRESS; name:ARRAY OF CHAR):LONGCARD;
  476. VAR
  477.     header :HeadPtr;
  478.     dest :ADDRESS;
  479. BEGIN
  480.     dataStackErr := noErr;
  481.     WITH stack^^ DO
  482.         IF filledCards = MAX(CARDINAL) THEN
  483.             dataStackErr := tooManyCards;
  484.             RETURN 0;
  485.             END; (* overflow cardLimit? *)
  486.         IF filledCards = initialCards THEN (* overflow initial stack space? *)
  487.             header := AddGrowCard(stack);
  488.             IF header = NIL THEN RETURN 0; END;
  489.         ELSE
  490.             header := VAL( ADDRESS, VAL(LONGCARD,filledCards) * VAL(LONGCARD,cardSize) )
  491.                                 + VAL(ADDRESS, dataPtr);
  492.             INC(filledCards);
  493.             END;
  494.         END;
  495.     
  496.     CopyStr(31,name,header^.cName);
  497.     INC(stack^^.totalFilled);
  498.     FillHeader(stack,header);
  499.     
  500.     dest := VAL(ADDRESS,header) + SIZE(CardHeader); (* data goes just after header. *)
  501.     BlockMove(data,dest,VAL(LONGINT,stack^^.cardSize-VAL(CARDINAL,SIZE(CardHeader))));
  502.     
  503.     RETURN header^.id;
  504.     END AddCard;
  505.  
  506. PROCEDURE FindKeyIndex(keysArrPtr:DataKeysPtr; indx,totFil:CARDINAL):CARDINAL;
  507. EXTERNAL;
  508.  
  509. (*
  510. PROCEDURE FindKeyIndex(keysArrPtr:DataKeysPtr; indx,totFil:CARDINAL):CARDINAL;
  511. VAR i :CARDINAL;
  512. BEGIN
  513.     i := 1;
  514.     REPEAT
  515.         IF keysArrPtr^[i] = indx THEN RETURN i; END;
  516.         INC(i);
  517.         UNTIL i > totFil;
  518.     RETURN 0;
  519.     END  FindKeyIndex;
  520. *)
  521.  
  522. PROCEDURE UpdateCardKeys(keysArrPtr:DataKeysPtr; indx,totFil:CARDINAL);
  523. VAR
  524.     targKeyIndx,lastKeyIndx :CARDINAL;
  525.     dst :ADDRESS;
  526. BEGIN
  527.     (* find index of key pointing to target card. *)
  528.     targKeyIndx := FindKeyIndex(keysArrPtr,indx,totFil);
  529.     
  530.     (* find index of key pointing to last card. *)
  531.     lastKeyIndx := FindKeyIndex(keysArrPtr,totFil,totFil);
  532.     
  533.     (* replace key to lastCard with indx (new location for lastCard). *)
  534.     keysArrPtr^[lastKeyIndx] := indx;
  535.     
  536.     (* move keys up and over indx of key pointing to target. *)
  537.     (* dst := VAL(LONGINT,targKeyIndx)*2 + VAL(ADDRESS,keysArrPtr); *)
  538.     dst := ADR(keysArrPtr^[targKeyIndx]);
  539.     BlockMove(dst+SIZE(CARDINAL),dst,VAL(LONGINT,totFil-targKeyIndx)*SIZE(CARDINAL));
  540.     END UpdateCardKeys;
  541.  
  542. PROCEDURE RemoveLastGrowBlock(stack:DataStack);
  543. VAR growHnd,preGrowHnd :GrowStack;
  544. BEGIN
  545.     preGrowHnd := NIL;
  546.     growHnd := stack^^.growStk; (* we know growStk is not NIL. *)
  547.     WHILE growHnd^^.growStk # NIL DO
  548.         preGrowHnd := growHnd;
  549.         growHnd := growHnd^^.growStk;
  550.         END;
  551.     IF preGrowHnd = NIL THEN (* remove first growStk. *)
  552.         DisposPtr(stack^^.growStk^^.dataPtr);
  553.         DisposHandle(stack^^.growStk);
  554.         stack^^.growStk := NIL;
  555.     ELSE
  556.         DisposPtr(growHnd^^.dataPtr);
  557.         DisposHandle(preGrowHnd^^.growStk);
  558.         preGrowHnd^^.growStk := NIL;
  559.         END;
  560.     END RemoveLastGrowBlock;
  561.  
  562. PROCEDURE RemoveLastCard(stack:DataStack);
  563. VAR growHnd :GrowStack;
  564. BEGIN
  565.     growHnd := stack^^.growStk;
  566.     IF growHnd = NIL THEN
  567.         DEC(stack^^.filledCards);
  568.     ELSE
  569.         WHILE growHnd^^.growStk # NIL DO
  570.             growHnd := growHnd^^.growStk;
  571.             END;
  572.             
  573.         IF growHnd^^.filledCards = 1 THEN
  574.             RemoveLastGrowBlock(stack);
  575.         ELSE
  576.             DEC(growHnd^^.filledCards);
  577.             END;
  578.         END;
  579.     DEC(stack^^.totalFilled);
  580.     END RemoveLastCard;
  581.  
  582. PROCEDURE RemoveCard(stack:DataStack; indx:CARDINAL; id:LONGCARD);
  583. VAR
  584.     targ,last :HeadPtr;
  585.     totFil :CARDINAL;
  586. BEGIN
  587.     IF indx > totFil THEN
  588.         dataStackErr := indxOutOfRange;
  589.         RETURN;
  590.     ELSE
  591.         dataStackErr := noErr;
  592.         END;
  593.         
  594.     (* get card index *)
  595.     IF (indx = 0) AND (id # 0) THEN
  596.         indx := GetCardIndx(stack,id,"");
  597.         END;
  598.     totFil := stack^^.totalFilled;
  599.     IF (indx = 0) OR (indx > totFil) THEN
  600.         dataStackErr := notFound;
  601.         RETURN;
  602.         END;
  603.     
  604.     (* get target and lastCard addresses *)
  605.     targ := GetHeaderAddr(stack,indx);
  606.     last := GetHeaderAddr(stack,totFil);
  607.     
  608.     (* replace lastCard keys with indx then shrink keysArrays. *)
  609.     UpdateCardKeys(stack^^.idKeys^,indx,totFil);
  610.     UpdateCardKeys(stack^^.nameKeys^,indx,totFil);
  611.  
  612.     (* blockmove lastCard over target *)
  613.     BlockMove(last,targ,VAL(LONGINT,stack^^.cardSize));
  614.     
  615.     (* remove lastCard and reduce totFil and local filledCards. *)
  616.     RemoveLastCard(stack);
  617.     END RemoveCard;
  618.  
  619.  
  620. PROCEDURE GetCardIndx(stack:DataStack; id:LONGCARD; name:ARRAY OF CHAR):CARDINAL;
  621. VAR n:CARDINAL;
  622. BEGIN
  623.     dataStackErr := noErr;
  624.     theStack := stack;
  625.     IF id # 0 THEN
  626.         theSearchID := id;
  627.         n := SearchStackByID(1,stack^^.totalFilled);
  628.         IF n = 0 THEN
  629.             dataStackErr := notFound;
  630.             RETURN 0;
  631.             END;
  632.         RETURN stack^^.idKeys^^[n];
  633.         
  634.     ELSIF name[0] # 0C THEN
  635.         theSearchName := ADR(name);
  636.         n := SearchStackByName(1,stack^^.totalFilled);
  637.         IF n = 0 THEN
  638.             dataStackErr := notFound;
  639.             RETURN 0;
  640.             END;
  641.         RETURN stack^^.nameKeys^^[n];
  642.         END;
  643.     dataStackErr := notFound;
  644.     RETURN 0;
  645.     END GetCardIndx;
  646.  
  647. PROCEDURE GetCardID(stack:DataStack; indx:CARDINAL; name:ARRAY OF CHAR):LONGCARD; 
  648. VAR header :HeadPtr;
  649. BEGIN
  650.     dataStackErr := noErr;
  651.     IF indx = 0 THEN
  652.         indx := GetCardIndx(stack,0,name);
  653.         IF indx = 0 THEN RETURN 0; END;
  654.         END;
  655.     header := GetHeaderAddr(stack,indx);
  656.     IF header = NIL THEN 
  657.         dataStackErr := notFound;
  658.         RETURN 0;
  659.         END;
  660.     RETURN header^.id;
  661.     END GetCardID;
  662.  
  663. PROCEDURE GetCardName(stack:DataStack; indx:CARDINAL; id:LONGCARD; VAR name:ARRAY OF CHAR);
  664. VAR header :HeadPtr;
  665. BEGIN
  666.     dataStackErr := noErr;
  667.     name := "";
  668.     IF indx = 0 THEN
  669.         indx := GetCardIndx(stack,id,"");
  670.         IF indx = 0 THEN RETURN END;
  671.         END;
  672.     header := GetHeaderAddr(stack,indx);
  673.     IF header = NIL THEN 
  674.         dataStackErr := notFound;
  675.         RETURN;
  676.         END;
  677.     CopyStr(31,header^.cName,name);
  678.     END GetCardName;
  679.  
  680. PROCEDURE SetCardName(stack:DataStack; indx,id:CARDINAL; name:ARRAY OF CHAR);
  681. VAR
  682.     header :HeadPtr;
  683.     strPtr :StringPtr;
  684.     oldKeyIndx,totFil,n :CARDINAL;
  685.     nKeys :DataKeysHnd;
  686.     src,dst :ADDRESS;
  687. BEGIN
  688.     dataStackErr := noErr;
  689.     totFil := stack^^.totalFilled;
  690.     nKeys := stack^^.nameKeys;
  691.     
  692.     IF indx = 0 THEN
  693.         indx := GetCardIndx(stack,id,"");
  694.         IF indx = 0 THEN RETURN END;
  695.         END;
  696.     header := GetHeaderAddr(stack,indx);
  697.     IF header = NIL THEN 
  698.         dataStackErr := notFound;
  699.         RETURN;
  700.         END;
  701.     CopyStr(31,name,header^.cName);
  702.     IF totFil = 1 THEN RETURN END;
  703.     
  704.     (* get nameKeyIndex for original *)
  705.     oldKeyIndx := FindKeyIndex(nKeys^, indx, totFil);
  706.     
  707.     dst := ADR(nKeys^^[oldKeyIndx]);
  708.     BlockMove(dst+SIZE(CARDINAL),dst,(totFil-oldKeyIndx)*SIZE(CARDINAL));
  709.     
  710.     (* find nameKeyIndex for new name *)
  711.     theStack := stack;
  712.     theSearchName := VAL(StringPtr,header);
  713.     n := SearchStackByName(1,totFil-1);
  714.     
  715.     IF (n = 0) AND (totFil > 1) THEN
  716.         (* Search failed, and the last index searched was theKeyIndex. *)
  717.         strPtr := VAL(StringPtr,GetHeaderAddr(stack,nKeys^^[theKeyIndex]));
  718.         IF IUCompString(theSearchName,strPtr) > 0 THEN INC(theKeyIndex) END;
  719.     ELSIF (n # 0) THEN
  720.         (* search found a card with same name, so we insert the new nameKey there. *)
  721.         theKeyIndex := n;
  722.         END;
  723.     
  724.     src := ADR(nKeys^^[theKeyIndex]);
  725.     BlockMove(src,src+SIZE(CARDINAL),(totFil-theKeyIndex)*SIZE(CARDINAL));
  726.     nKeys^^[theKeyIndex] := indx;
  727.     END SetCardName;
  728.  
  729.  
  730. PROCEDURE CountCards(stack:DataStack):CARDINAL;
  731. BEGIN
  732.     RETURN stack^^.totalFilled;
  733.     END CountCards;
  734.  
  735. PROCEDURE GetCardByIndx(stack:DataStack; indx:CARDINAL):ADDRESS;
  736. VAR a :ADDRESS;
  737. BEGIN
  738.     dataStackErr := noErr;
  739.     a := VAL(ADDRESS,GetHeaderAddr(stack,indx));
  740.     IF a = NIL THEN
  741.         dataStackErr := notFound;
  742.         RETURN NIL;
  743.     ELSE
  744.         RETURN a + SIZE(CardHeader);
  745.         END;
  746.     END GetCardByIndx;
  747.  
  748. PROCEDURE GetCardByID(stack:DataStack; id:LONGCARD):ADDRESS;
  749. VAR a :ADDRESS;
  750. BEGIN
  751.     dataStackErr := noErr;
  752.     a := VAL(ADDRESS,GetHeaderAddr(stack,GetCardIndx(stack,id,"")));
  753.     IF a = NIL THEN
  754.         dataStackErr := notFound;
  755.         RETURN NIL;
  756.     ELSE
  757.         RETURN a + SIZE(CardHeader);
  758.         END;
  759.     END GetCardByID;
  760.  
  761. PROCEDURE GetCardByName(stack:DataStack; name:ARRAY OF CHAR):ADDRESS;
  762. VAR a :ADDRESS;
  763. BEGIN
  764.     dataStackErr := noErr;
  765.     a := VAL(ADDRESS,GetHeaderAddr(stack,GetCardIndx(stack,0,name)));
  766.     IF a = NIL THEN
  767.         dataStackErr := notFound;
  768.         RETURN NIL;
  769.     ELSE
  770.         RETURN a + SIZE(CardHeader);
  771.         END;
  772.     END GetCardByName;
  773.  
  774.  
  775. PROCEDURE ForAllCardsDo(stack:DataStack; do:DoProc);
  776. VAR i :CARDINAL;
  777. BEGIN
  778.     FOR i := 1 TO stack^^.totalFilled DO
  779.         do(VAL(ADDRESS,GetHeaderAddr(stack,i)) + SIZE(CardHeader));
  780.         END;
  781.     END ForAllCardsDo;
  782.  
  783. PROCEDURE InIDOrderDo(stack:DataStack; do:DoProc);
  784. VAR i,n :CARDINAL;
  785. BEGIN
  786.     FOR i := 1 TO stack^^.totalFilled DO
  787.         n := stack^^.idKeys^^[i];
  788.         do(VAL(ADDRESS,GetHeaderAddr(stack,n)) + SIZE(CardHeader));
  789.         END;
  790.     END InIDOrderDo;
  791.  
  792. PROCEDURE InNameOrderDo(stack:DataStack; do:DoProc);
  793. VAR i,n :CARDINAL;
  794. BEGIN
  795.     FOR i := 1 TO stack^^.totalFilled DO
  796.         n := stack^^.nameKeys^^[i];
  797.         do(VAL(ADDRESS,GetHeaderAddr(stack,n)) + SIZE(CardHeader));
  798.         END;
  799.     END InNameOrderDo;
  800.  
  801.  
  802. END DataStacks.
  803.  
  804.